home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 7 / FM Towns Free Software Collection 7.iso / t_os / tifdsp / tifdsp.bas < prev    next >
Encoding:
BASIC Source File  |  1993-11-30  |  8.3 KB  |  206 lines
  1. 1000 '*******************************************************************
  2. 1010 'SAVE "TIFDSP.BAS",A
  3. 1020 '                          V1.0            93.08.08
  4. 1030 '                                              ＢＥＮ＆ＫＥＩ
  5. 1040 '*******************************************************************
  6. 1050 CLEAR ,,512,600000,0:DEFINT A-Z
  7. 1060 TOWNS=1:ON ERROR GOTO *ERRR
  8. 1070 SCREEN@ 0:CONSOLE 0,22,0:WIDTH 80,25:W20=20:W12=12:A=0
  9. 1080 W10=10
  10. 1090 'IF FMR=1 THEN SHELL "CD","\LIB"
  11. 1100 CLS:PALETTE 8,[82,82,128]:COLOR 7,%8,7,4
  12. 1110 C4=9:C2=1:DIM T$(20):COA=20:DIM OA$(COA),OAN(COA)
  13. 1120 T$(0)="Ｆｒｅｅ　　　　　Ｗａｒｅ　ＣＯＬＬＥＣＴＩＯＮ　１"
  14. 1130 T$(1)="Ｆｒｅｅ　　　　　Ｗａｒｅ　ＣＯＬＬＥＣＴＩＯＮ　２"
  15. 1140 T$(2)="Ｆｒｅｅ　　　　　Ｗａｒｅ　ＣＯＬＬＥＣＴＩＯＮ　３"
  16. 1150 T$(3)="Ｆｒｅｅ　Ｓｏｆｔｗａｒｅ　ＣＯＬＬＥＣＴＩＯＮ　４"
  17. 1160 T$(4)="Ｆｒｅｅ　Ｓｏｆｔｗａｒｅ　ＣＯＬＬＥＣＴＩＯＮ　５"
  18. 1170 T$(5)="Ｆｒｅｅ　Ｓｏｆｔｗａｒｅ　ＣＯＬＬＥＣＴＩＯＮ　６"
  19. 1180 T$(6)="Ｔｏｗｎｓシステムソフトウェア　Ｖ２．１　Ｌ２０　　"
  20. 1190 T$(7)="Ｆ－ＢＡＳＩＣ３８６コンパイラ　Ｖ２．１　Ｌ１０　　"
  21. 1200 *START CLOSE:SCREEN@ 0
  22. 1210 CLS:PALETTE 8,[82,82,128]:COLOR 7,%8,7,4
  23. 1220 CLS:LOCATE W20-10,W12-6:COLOR 4:PRINT "フリコレのTIFフアイルを自動ですべて表示プログラム     V1.1"
  24. 1230 LOCATE W20,W12-4:COLOR 4:PRINT "        気に入った絵はコピーもできます　 "
  25. 1240 LOCATE W20+30,W12-2:COLOR 4:PRINT "           Ｂｅｎ＆ｋｅｉ"
  26. 1250 LOCATE W10,W12+0:COLOR 7:PRINT T$(0)
  27. 1260 LOCATE W10,W12+1:COLOR 7:PRINT T$(1)
  28. 1270 LOCATE W10,W12+2:COLOR 7:PRINT T$(2)
  29. 1280 LOCATE W10,W12+3:COLOR 7:PRINT T$(3)
  30. 1290 LOCATE W10,W12+4:COLOR 7:PRINT T$(4)
  31. 1300 LOCATE W10,W12+5:COLOR 7:PRINT T$(5)
  32. 1310 LOCATE W10,W12+6:COLOR 7:PRINT T$(6)
  33. 1320 LOCATE W10,W12+7:COLOR 7:PRINT T$(7)
  34. 1330 LOCATE W10,W12+8:COLOR 7:PRINT "終了 　"
  35. 1340 LOCATE W20,25:COLOR 7
  36. 1350 PRINT "↑ ↓ で選択して  リターンを押してください";
  37. 1360 LOCATE W10-4,W12:COLOR 6:PRINT "★":A=0
  38. 1370 A$=INPUT$(1)
  39. 1380 IF A$=CHR$(&H1F) THEN OA=A:A=(A+1) MOD C4
  40. 1390 IF A$=CHR$(&H1E) THEN OA=A:A=(A+C4-1) MOD C4
  41. 1400 IF A$=CHR$(&H1B) THEN CLOSE:CLEAR ,,512,4096:END
  42. 1410 IF A$=CHR$(&H0D) THEN 1450
  43. 1420 LOCATE W10-4,W12+C2*A:PRINT "★":LOCATE W10-4,W12+C2*OA:PRINT "  "
  44. 1430 GOTO 1370
  45. 1440 CLEAR ,,512,4096:END
  46. 1450 B=A+1:CBB=A:FOR III=1 TO 10:KEY III,"        ":NEXT III
  47. 1460 IF B=1 THEN N$="free1":GOTO *GR3
  48. 1470 IF B=2 THEN N$="free2":GOTO *GR3
  49. 1480 IF B=3 THEN N$="free3":GOTO *GR3
  50. 1490 IF B=4 THEN N$="free4r":GOTO *GR3
  51. 1500 IF B=5 THEN N$="free5":GOTO *GR3
  52. 1510 IF B=6 THEN N$="free6":GOTO *GR3
  53. 1520 IF B=7 THEN N$="tsys2120":GOTO *GR3
  54. 1530 IF B=8 THEN N$="fbsc2110":GOTO *GR3
  55. 1540 IF B=9 THEN CLOSE:KEY (1) OFF:KEY (2) OFF::GOTO *END
  56. 1550 CLOSE:GOTO *END
  57. 1560 *END
  58. 1570 KEY (3) OFF:KEY(4) OFF:KEY(5) OFF
  59. 1580 IF TOWNS=1 THEN SHELL "CD \":SYSTEM:END
  60. 1590 'IF FMR=1 THEN SHELL "CD","\":SYSTEM
  61. 1600 ' STOP
  62. 1610 *ERRR 
  63. 1620 ON ERROR GOTO 0
  64. 1630 PRINT  ERR,ERL:END
  65. 1640 'CLS:PALETTE 8,[80,64,128]:COLOR 7,%8,7,4
  66. 1650 *GR3
  67. 1660 SC=0:MOUSE 0:CONSOLE 0,25,0:WIDTH 80,25:SCREEN@ SC:A=0:C23=25
  68. 1670 ON ERROR GOTO *ERR
  69. 1680 ON KEY(1) GOSUB *CAN
  70. 1690  KEY (1) ON
  71. 1700 ON KEY(2) GOSUB *COPY
  72. 1710  KEY (2) ON
  73. 1720 ON KEY(3) GOSUB *SCLS
  74. 1730  KEY (3) ON
  75. 1740 ON KEY(5) GOSUB *SBACK
  76. 1750  KEY (5) ON
  77. 1760 ON KEY(4) GOSUB *DSTOP
  78. 1770  KEY (4) ON
  79. 1780 OPEN "I",#1,N$+".TIF":CLS:LOCATE 0,24
  80. 1790 'OPEN "I",#1,"\FREEWAR3.TIF":CLS:LOCATE 0,24
  81. 1800 LOCATE 0,5
  82. 1810 PRINT "　　　　　"+T$(CBB):PRINT 
  83. 1820 LOCATE 0,7
  84. 1830 PRINT "　　　　　をＣＤ－ＲＯＭドライブにセットしてください":PRINT 
  85. 1840 LOCATE 0,9
  86. 1850 PRINT "　　　　　なにかキーをおしてください":PRINT 
  87. 1860 LOCATE 0,11
  88. 1870 PRINT "　　　　　";:LINE INPUT XXX$:PRINT 
  89. 1880 LOCATE 0,13
  90. 1890 PRINT "　　　　　数字またはキーワードをいれてください":PRINT 
  91. 1900 LOCATE 0,15
  92. 1910 PRINT "　　　　　数字はＴＩＦファイルの番号です":PRINT 
  93. 1920 LOCATE 0,17
  94. 1930 PRINT "　　　　　キーワードはパス名に含まれる文字列です":PRINT 
  95. 1940 LOCATE 10,19
  96. 1950 PRINT "どちらか一方もしくはリターンのみでもけっこうです":PRINT 
  97. 1960 LOCATE 10,21
  98. 1970 INPUT R$
  99. 1980 CLS:LOCATE 0,C23
  100. 1990 PRINT "ＰＦ１　ＰＦ２　ＰＦ３　ＲＦ４　ＰＦ５　マウスの左ボタンが使用可能です";
  101. 2000 COLOR 6,0,7,4
  102. 2010 IF R$="" THEN DSW=1:GOTO 2040 ELSE DSW=0
  103. 2020 R=VAL(R$):IF R=0 THEN 2040
  104. 2030 FOR I=1 TO R:LINE INPUT #1,A$:NEXT I:R$="":DSW=1:A=I-2
  105. 2040 WHILE NOT(EOF(1))
  106. 2050 KEY (2) STOP
  107. 2060 OA$=A$:OI=A:LINE INPUT #1,A$:A=A+1
  108. 2070 IF R$="" THEN 2100
  109. 2080 IF DSW=0 AND INSTR(A$,R$)=0 THEN 2240 
  110. 2090 IF DSW=0 AND INSTR(A$,R$)>0 THEN R$="":DSW=1
  111. 2100 COLOR 6,0,7,4
  112. 2110 LOCATE 0,C23:PRINT USING                                             "#####  &                                                 &    MODE=#       ";A,A$,SC;
  113. 2120 GOSUB *TAIHI
  114. 2130 IF MOUSE(2,1) THEN FOR XL=1 TO 10000:NEXT XL:CLS 5
  115. 2140 IF SCLS THEN FOR XL=1 TO 10000:NEXT XL:CLS 5
  116. 2150 'IF MOUSE(2,1) THEN WHILE MOUSE(2,1)=-1:WEND:WHILE MOUSE(2,1)=0:WEND:CLS 5
  117. 2160 LOAD@ A$
  118. 2170 IF DXXSW=1 THEN DXXSW=2:A$=OA$:GOTO 2160
  119. 2180 *FFFF IF DXXSW=2 THEN *FFFF
  120. 2190 KEY (2) ON
  121. 2200 IF MOUSE(2,0) THEN LOCATE 75,C23 :PRINT "STOP";: WHILE MOUSE(2,0)=-1:WEND:WHILE MOUSE(2,0)=0:WEND:LOCATE 75,C23:PRINT "    ";
  122. 2210 LOCATE 0,C23:PRINT USING                                             "#####  &                                                 &    MODE=#       ";A,A$,SC;
  123. 2220 ORX$=R$:LOCATE ,24
  124. 2230 IF DSW=1 AND R$<>"" THEN DSW=0
  125. 2240 WEND
  126. 2250 CLOSE:GOTO 1200
  127. 2260 *ERR:PRINT ERR,ERL
  128. 2270 IF ERL=2160 AND ERR=63 THEN RESUME *CDERROR
  129. 2280 IF ERL=2160 AND ERR<>28 THEN SC=(SC+1) MOD 3:SCREEN@ SC:RESUME 2160
  130. 2290 IF ERL=2790 AND ERR<>28 THEN SC=(SC+1) MOD 3:SCREEN@ SC:RESUME 2790
  131. 2300 IF ERL=2160 AND ERR=28 THEN LOCATE 0,C23:PRINT A$,"ERR=";ERR,"ERL=";ERL:CLS 4:RESUME 2200
  132. 2310 PRINT ERR,ERL
  133. 2320 ON ERROR GOTO 0
  134. 2330 END
  135. 2340 CLOSE:GOTO 1200
  136. 2350 SC=0:MOUSE 0:CONSOLE 0,25,0:WIDTH 80,25:SCREEN@ SC:A=0:C23=25
  137. 2360 *CAN
  138. 2370 CLOSE:RETURN 1200 
  139. 2380 *COPY
  140. 2390 SCREEN@ 0:CONSOLE 0,0,0:COLOR 7,0,0,4
  141. 2400 CLS:LOCATE 10,5
  142. 2410 PRINT LEFT$(OA$,2)+"(1)"+MID$(OA$,3);
  143. 2420 PRINT "絵のファイルをコピーします":PRINT 
  144. 2430 PRINT "　　　　　格納先の":PRINT 
  145. 2440 PRINT "　　　　　［ドライブ名:］［[\]デレクトリ名\］［ファイル名(拡張子なし)］":PRINT 
  146. 2450 LINE INPUT "　　　　　＝",XFIL$
  147. 2460 XFIL$=XFIL$+".TIF"
  148. 2470 PRINT      "　格納ファイル名             "+XFIL$
  149. 2480 PRINT      "　                           ＯＫ...Y　ＮＯ...N　　";
  150. 2490 LINE INPUT XX$
  151. 2500 IF XX$="Y" OR XX$="y" THEN 2510 ELSE CLS :GOTO 2400 
  152. 2510 'save "fcopyw.bas",a
  153. 2520 PRINT      "　    ただいま格納しています しばらくおまちください 　";
  154. 2530 OPEN "I",#2,OA$
  155. 2540 OPEN "O",#3,XFIL$
  156. 2550 WHILE NOT(EOF(2))
  157. 2560 AXX$=INPUT$(1,2)
  158. 2570 PRINT #3,AXX$;
  159. 2580 WEND
  160. 2590 CLOSE 2,3:CLS
  161. 2600 RETURN
  162. 2610 *DSTOP
  163. 2620 LOCATE 75,C23:
  164. 2630 IF DXXSW>=1 THEN DXXSW=0:PRINT "    "; ELSE DXXSW=1:PRINT "STOP";
  165. 2640 RETURN
  166. 2650 *TAIHI
  167. 2660 FOR IV=COA TO 1 STEP -1
  168. 2670    OA$(IV)=OA$(IV-1):OAN(IV)=OAN(IV-1)
  169. 2680 NEXT IV
  170. 2690 OA$(0)=A$:OAN(0)=A
  171. 2700 RETURN
  172. 2710 *SBACK
  173. 2720 LOCATE 0,C23:PRINT "方向キー または リターン                                               ";
  174. 2730 IV=1
  175. 2740 IF OA$(0)="" THEN 2840
  176. 2750 IF OA$(IV)="" AND UPSW=1 THEN IV=0:GOTO 2740 
  177. 2760 IF MOUSE(2,1) THEN FOR XL=1 TO 10000:NEXT XL:CLS 5
  178. 2770 IF SCLS THEN FOR XL=1 TO 10000:NEXT XL:CLS 5
  179. 2780 'IF MOUSE(2,1) THEN WHILE MOUSE(2,1)=-1:WEND:WHILE MOUSE(2,1)=0:WEND:CLS 5
  180. 2790 LOAD@ OA$(IV)
  181. 2800 LOCATE 0,C23:PRINT USING "方向キー または リターン##### &                                     & page=##";OAN(IV),OA$(IV),IV;
  182. 2810 XXX$=INKEY$:IF XXX$="" THEN 2810
  183. 2820 IF XXX$=CHR$(&H1E) OR XXX$=CHR$(&H1C) THEN UPSW=1:IV=IV+1:GOTO 2850
  184. 2830 IF XXX$=CHR$(&H1F) OR XXX$=CHR$(&H1D) THEN UPSW=0:IV=IV-1:GOTO 2850
  185. 2840 LOCATE 0,C23:PRINT "                                                                         ";:RETURN
  186. 2850 IF IV<0 THEN IV=COA
  187. 2860 IF IV>COA THEN IV=0
  188. 2870 IF OA$(IV)="" AND UPSW=0 THEN IV=IV-1:IF IV<0 THEN 2840 ELSE 2870
  189. 2880 GOTO 2740
  190. 2890 *SCLS
  191. 2900 IF SCLS=0 THEN SCLS=-1 ELSE SCLS=0
  192. 2910 RETURN
  193. 2920 *CDERROR
  194. 2930 CLS
  195. 2940 LOCATE 0,3
  196. 2950 PRINT "　　　　　ＣＤ－ＲＯＭがちがいます":PRINT 
  197. 2960 LOCATE 0,5
  198. 2970 PRINT "　　　　　"+T$(CBB):PRINT 
  199. 2980 LOCATE 0,7
  200. 2990 PRINT "　　　　　をＣＤ－ＲＯＭドライブにセットしてください":PRINT 
  201. 3000 LOCATE 0,9
  202. 3010 PRINT "　　　　　なにかキーをおしてください":PRINT 
  203. 3020 LOCATE 0,11
  204. 3030 PRINT "　　　　　";:LINE INPUT XXX$:PRINT 
  205. 3040 GOTO *START
  206.